home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / smaltalk / manchest.lha / MANCHESTER / usenet / st80_pre4 / pbm.st < prev    next >
Text File  |  1993-07-24  |  7KB  |  262 lines
  1. "    NAME        pbm
  2.     AUTHOR        kww@cs.glasgow.ac.uk
  3.     FUNCTION  Conversion between Forms and PBM
  4.     ST-VERSIONS    2.5
  5.     PREREQUISITES     
  6.     CONFLICTS    
  7.     DISTRIBUTION      world
  8.     VERSION        1.1
  9.     DATE    14 May 1990
  10. SUMMARY    The following file-in supports the reading and writing of
  11. Smalltalk Forms (here wrapped up in what I call an IconImage - a
  12. simple way of naming a Form) into the Portable Bitmap file format.
  13. "!
  14. "
  15. From: kww@cs.glasgow.ac.uk (Dr Kevin Waite)
  16. Newsgroups: comp.lang.smalltalk
  17. Subject: Conversion between Forms and PBM
  18. Message-ID: <5238@vanuata.cs.glasgow.ac.uk>
  19. Date: 14 May 90 17:33:39 GMT
  20. Organization: Computing Sci, Glasgow Univ, Scotland
  21.  
  22. The following file-in supports the reading and writing of Smalltalk
  23. Forms (here wrapped up in what I call an IconImage - a simple way of
  24. naming a Form) into the Portable Bitmap file format.  This format
  25. (copyrighted by Jef Poskanzer) is a lowest-common denominator allowing
  26. bitmap images to be sent over the mail, and converted between a whole
  27. variety of different formats including PICT, GIF, MacPaint, Sun Icons,
  28. Postscript, ASCII, etc.  I wrote this utility to make use of the Sun
  29. icon collection but have found it useful in taking images over from my
  30. Macintosh as well.  I hope you find it useful.  Any comments on the
  31. code (yes I know its a bit messy!!) are welcome.
  32.  
  33. BTW, PBM is a public domain utility available on (at least) a variety of
  34. UNIX platforms.   The following piece of code is perhaps not as lenient
  35. of dodgy input as Poskanzer would like!!
  36.  
  37. Cheers,
  38.    Kevin
  39.  
  40. Email:   kww@uk.ac.glasgow.cs  (JANET)
  41.      kww%cs.glasgow.ac.uk@nsfnet-relay.ac.uk  (INTERNET)
  42. Address: Dept. of Computing Science,  University of Glasgow,
  43.      17 Lilybank Gardens,  Glasgow,  United Kingdom.  G12 8QQ
  44. "
  45.  
  46. 'From Objectworks for Smalltalk-80(tm), Version 2.5 of 29 July 1989 
  47. on 14 May 1990 at 6:25:56 pm'!
  48.  
  49. Object subclass: #IconImage
  50.     instanceVariableNames: 'name form '
  51.     classVariableNames: ''
  52.     poolDictionaries: ''
  53.     category: 'Icon-Browsing'!
  54. IconImage comment:
  55. 'I represent a named graphical image.  My instance variables
  56. hold my name and the Form that is my graphical representation.
  57. I support loading and saving using the Portable Bitmap format
  58. and thereby onto other graphical formats via the many conversion
  59. tools available in the PBM library.
  60.  
  61. The Portable Bitmap facility is copyright (c) 1988 by Jef Poskanzer.'!
  62.  
  63.  
  64. !IconImage methodsFor: 'accessing'!
  65.  
  66. form
  67.     ^form!
  68.  
  69. form: aForm
  70.     form := aForm.!
  71.  
  72. name
  73.     ^name!
  74.  
  75. name: aString
  76.     name := aString.! !
  77.  
  78. !IconImage methodsFor: 'file-in/out'!
  79.  
  80. writePBMfile: fileName
  81.     "Saves the receiver on the file fileName in Portable Bitmap format.
  82.     See the class method pbmSyntax for details of the format."
  83.     
  84.     | aStream bitMask wordCount bitCount bitsOnLine |
  85.  
  86.     aStream := fileName asFilename writeStream.
  87.     aStream nextPutAll: 'P1'; cr.
  88.     aStream nextPutAll: '#  Converted from Smalltalk Form on '.
  89.      aStream nextPutAll: Date today printString.
  90.     aStream nextPutAll: ' at ', Time now printString.
  91.     aStream cr.
  92.     aStream nextPutAll: self form width printString.
  93.     aStream space.
  94.     aStream nextPutAll: self form height printString.
  95.     aStream cr.
  96.  
  97.     bitMask := Array new: 16.
  98.     1 to: 16 do: [:k | bitMask at: k put: (1 bitShift: (k-1))].
  99.  
  100.     wordCount := self form width + 15 // 16 * self form height.
  101.  
  102.     "The following two counters are used to ensure that newlines are
  103.     forced on the stream after every 70 characters and after every
  104.     row has been completed (unless the row is shorter than 70 chars)."
  105.     
  106.     bitsOnLine := bitCount := 0.
  107.  
  108.     1 to: wordCount do: [:index |
  109.         | endOfRow word bitNum bit |
  110.  
  111.         word := self form bitsWordAt: index.
  112.         bitNum := 16.
  113.         endOfRow := false.
  114.         [bitNum = 0 or: [endOfRow]] whileFalse: [
  115.             bit := word bitAnd: (bitMask at: bitNum).
  116.             aStream nextPut: (bit = 0 ifTrue: [$0] ifFalse: [$1]).
  117.             bitsOnLine := bitsOnLine + 1.
  118.             bitsOnLine > 70 ifTrue: [
  119.                 aStream cr.
  120.                 bitsOnLine := 0.
  121.             ].
  122.             bitNum := bitNum - 1.
  123.             endOfRow := (bitCount := bitCount + 1) = self form width.
  124.         ].
  125.         endOfRow ifTrue: [
  126.             aStream cr.
  127.             bitCount := bitsOnLine := 0.
  128.         ].
  129.     ].
  130.     aStream close.! !
  131.  
  132. !IconImage methodsFor: 'initialisation'!
  133.  
  134. initialize
  135.     self name: 'an Image'.
  136.     self form: nil.! !
  137. "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!
  138.  
  139. IconImage class
  140.     instanceVariableNames: ''!
  141.  
  142.  
  143. !IconImage class methodsFor: 'instance creation'!
  144.  
  145. new
  146.     ^super new initialize!
  147.  
  148. pbmSyntax
  149.     "- A 'magic number' for identifying the  file  type.   A  pbm
  150.        file's magic number is the two characters 'P1'.
  151.  
  152.      - Whitespace (blanks, TABs, CRs, LFs).
  153.  
  154.      - A width, formatted as ASCII characters in decimal.
  155.  
  156.      - Whitespace.
  157.  
  158.      - A height, again in ASCII decimal.
  159.  
  160.      - Whitespace.
  161.  
  162.      - Width * height bits, each either '1' or '0',  starting  at
  163.        the  top-left  corner  of  the bitmap, proceding in normal
  164.        English reading order.
  165.  
  166.      - The character '1' means black, '0' means white.
  167.  
  168.      - Whitespace in the bits section is ignored.
  169.  
  170.      - Characters from a '#' to the next end-of-line are  ignored
  171.        (comments).
  172.  
  173.      - No line may be longer than 70 characters."!
  174.  
  175. readImageFromPBMFile: fileName
  176.     "Answer an instance of IconImage initialized from a Portable Bit Map
  177.     file.  The expected format of the file is in the method
  178.     IconImage class>pbmSyntax."
  179.  
  180.     | aFile aStream width height bits form bitMask index shift image |
  181.  
  182.     aFile := fileName asFilename.
  183.     aFile exists ifFalse: [^nil].
  184.     aStream := aFile readStream.
  185.  
  186.     (aStream peek = $P) 
  187.         ifFalse: [self error: 'Invalid magic number'] 
  188.         ifTrue: [aStream next].
  189.  
  190.     (aStream peek = $1) 
  191.         ifFalse: [self error: 'Invalid magic number'] 
  192.         ifTrue: [aStream next].
  193.  
  194.     self skipPBMJunkOn: aStream.
  195.     width := Integer readFrom: aStream.
  196.     width > 0 ifFalse: [self error: 'Invalid width'].
  197.  
  198.     self skipPBMJunkOn: aStream.
  199.     height := Integer readFrom: aStream.
  200.     height > 0 ifFalse: [self error: 'Invalid height'].
  201.     bits := WordArray new: (width + 15 // 16 * height).
  202.     form := Form new extent: width@height.
  203.  
  204.     "Initialize an array of sixteen 16-bit numbers each with a single
  205.     unique bit set corresponding to a power of two.  This will simplify
  206.     the setting of of pixel values within a compressed word."
  207.  
  208.     bitMask := Array new: 16.
  209.     1 to: 16 do: [:k | bitMask at: k put: (1 bitShift: (k-1))].
  210.  
  211.     index := 1.
  212.  
  213.     1 to: height do: [:y | | word |
  214.         shift := 16.
  215.         word := 0.
  216.  
  217.         1 to: width do: [:x | 
  218.             self skipPBMJunkOn: aStream.
  219.             aStream atEnd ifTrue: [self error: 'Unexpected End-of-file'].
  220.  
  221.             aStream next = $1 
  222.                 ifTrue: [word := word bitOr: (bitMask at: shift)].
  223.  
  224.             shift := shift - 1.
  225.             shift = 0 ifTrue: [ "End of the current word?"
  226.                 bits at: index put: word.
  227.                 index := index + 1.
  228.                 shift := 16.
  229.                 word := 0.
  230.             ].
  231.         ].
  232.         shift < 16 ifTrue: [ "A partly filled words needs to be saved."
  233.             bits at: index put: word.
  234.             index := index + 1.
  235.         ].
  236.     ].
  237.     form bits: bits.
  238.     aStream close.
  239.     image := self new form: form.
  240.     image name: fileName.
  241.     ^image! !
  242.  
  243. !IconImage class methodsFor: 'parsing utilities'!
  244.  
  245. skipPBMJunkOn: aStream
  246.     "This method removes any superfluous characters 
  247.     from the input stream."
  248.  
  249.     | char |
  250.  
  251.     [char := aStream peek.
  252.      char = $# ifTrue: ["Start of a comment.  Skip to end-of-line."
  253.         | foundNL |
  254.  
  255.         foundNL := (aStream skipUpTo: Character cr) notNil.
  256.         foundNL ifFalse: ["Must be EOF"  ^self].
  257.         char := aStream peek.
  258.     ].
  259.     aStream atEnd not and: [char isSeparator]] whileTrue: [aStream next].! !
  260.  
  261.  
  262.